;;############################################################################
;; crosstab.lsp
;; Copyright (c) 1999-2000 by Forrest W. Young
;; code for visualization of general (crosstab) data 
;;   (data with category plus multivariate numeric)
;; all methods in this file used only by crosstabs visualizations
;;############################################################################


#|replaced by function in datasmry.lsp

(defun crosstabulate-data ()
;================================================================
  #+containers
  (progn
   (send *watcher* :write-text "Constructing Container Object")
   (setf *spreadplot-container* 
         (make-container :size (send *vista* :spreadplot-sizes) 
                         :free *free-spreadplots*
                         :local-menus *free-spreadplots*
                         :type 1 ;7 1 3
                         :show nil)))
;================================================================
  (send *current-data* :visualize-nway-freq-array t)

;================================================================
  #+containers
  (progn
   (send *watcher* :write-text "Showing Spreadplot")
   (apply #'send *spreadplot-container* :location 
          (send *vista* :workmap-location))
   (apply #'send *spreadplot-container* :size 
          (send *vista* :spreadplot-sizes))
   (send *spreadplot-container* :show-window) 
   (refresh-spreadplot)
   (disable-container)
   )
;================================================================
  ) |#


            
(defmeth datasheet-proto :do-control-panel-click (x y m1 m2 mvdob) 
  (when (send *vista* :screen-saver-on)
        (when *screen-saver*
              (if (send *screen-saver* :showing)
                  (send *workmap* :hide-screen-saver)
                  (send *workmap* :reset-screen-saver))))
  (cond
    ((send *vista* :show-help)
     (error-message "To use the DataSheet, you must turn Menu Help off")) 
    ((< y 16) (send (first (send self :slot-value 'overlays)) :do-click x y m1 m2))
    (t
  (let* ((splot (send self :spreadplot-object))
         (n-all-numordvar (send splot :n-numordvar))
         (numord-vars (send splot :active-numord-vars))
         (n-numord (length numord-vars))
         (numord-var-indices (send splot :active-numord-vars-indices))
         (numord-types (send splot :active-numord-types))
         (stats (list (send splot :active-stats)))
         (splotainer (send splot :container))
         (dob (send self :data-object))
         (report (aref (send splot :plot-matrix) 2 1))
         (w report)
         (fw  (send self :field-width))
         (fh  (send self :field-height))
         (lw  (send self :label-width))
         (x+ (send self :x+)) 
         (y+ (send self :y+))
         (old-hot-cell (send self :hot-cell))
         (ready (send self :hot-cell-ready))
         (nobs (send self :nobs))
         (nvar (send self :nvar))
         (cur-data *current-data*)
         (new-var nil)
         (new-obs nil)
         (body nil)
         (col (ceiling (- (- x x+) lw) fw))
         (row (- (ceiling (- y y+) fh) 2))
         (dat-mat)
         (data-row row)
         (data-col col)
         (n-hot-rows nobs)
         (n-hot-cols nvar)
         (cell-nobs)
         (corcov)
         (cell-nvar (length numord-vars))
         (plot-msg )
         (num-indices (length (send mvdob :slot-value 'nways-of-table)))
         )
    (when (= nobs 1)
          (setf data-row col)
          (setf data-col row)
          (setf n-hot-rows 2)
          (setf n-hot-cols nvar))
    (mapcar #'(lambda (index)
                (cond 
                  ((= index 4) (setf (select stats 0) (remove 4 (first stats)) )
                   (setf corcov t))
                  ((> index 4) (setf plot-msg t))))
            (first stats))
;(print (list (list row col) (list data-row data-col)(list nobs nvar)))
;(print (list corcov plot-msg))
;(print stats)
;(print numord-vars)
;(print numord-types)
    (enable-container splotainer)
    (unless (send mvdob :has-slot 'nways-of-table)
            (send mvdob :add-slot 'nways-of-table))
    (if (not num-indices ) (setf indices 2))
    (when (and (> row 0) (> col 0) (< row n-hot-rows) (< col n-hot-cols))
          (setf body t)
          (send report :flush-window)

          (setf cell-data 
                (if (= num-indices 1)
                    (aref (send dob :data-array) (1- data-col) (1- data-row))
                    (aref (send dob :data-array) (1- data-row) (1- data-col))))

;(print cell-data)

          (cond
            ((not cell-data) (send report :flush-window)
             (display-string (format nil "~%No Data in this cell.") report);w
             (send report :scroll 0 0);w
             )
            (t
             (setf cell-nobs (/ (length cell-data) n-all-numordvar))
             (setf cell-data (matrix (list cell-nobs n-all-numordvar) cell-data))
             (setf cell-data (apply #'bind-columns (select (column-list cell-data) 
                                                   numord-var-indices)))
             (when (member 0 (first stats))
                  ; (send sp :update-spreadplot 1 0 nil)
                   (send mvdob :data-info report nil ))
             (when (member 1 (first stats))
                  ; (send sp :update-spreadplot 1 1 cell-data numord-types numord-vars 
                  ;       (repeat "Obs" cell-nobs))
                   (send self :print-data-listing 
                         cell-data 
                         numord-types
                         numord-vars
                         (repeat "Obs" cell-nobs)
                         report))
             (when (or (member 2 (first stats)) (member 3 (first stats)))
                   ;(send sp :update-spreadplot 1 2 cell-data numord-types numord-vars
                   ;      (1- stats) (member 1 (first stats)))
                   (send mvdob :describe-data 
                         (column-list cell-data )
                         numord-vars
                         (1- stats)
                         :draw-line (member 1 (first stats));0
                         :types numord-types
                         :window w))
             (when corcov
                   ;(send sp :update-spreadplot 1 3 cell-data numord-types numord-vars)
                   (send mvdob :describe-relations-new 
                         report nil numord-vars (column-list cell-data) numord-types))
             (when plot-msg (display-string (format nil "~%Plots not yet implemented.") w))
             (setcd cur-data)
             ))
          (send w :scroll 0 0)
          (send self :hot-cell (list row col))
          (send self :reverse-cell-color row col lw fw fh))
    ;(when old-hot-cell
    ;      (setf row (first  old-hot-cell))
    ;      (setf col (second old-hot-cell))
    ;      (send self :reverse-cell-color row col lw fw fh ready))
    (when ready (send self :hot-cell-ready nil))
    
    ))))


(defmeth mv-data-object-proto :describe-relations-new (w table varnames variables types)
  (let* ((numvar-locs ($position '("numeric") types))
         (num-variables (select variables numvar-locs))
         (data-matrix (lists-to-matrix num-variables))
         (row-column-labels (select varnames numvar-locs))
         (nactvar (length row-column-labels))
         )
    (cond 
      ((and (> (length (first variables)) 2) (> nactvar 1))
       (display-string (format nil "~2%CORRELATIONS (Numeric Variables)~%") w)
       (print-matrix-to-window 
        (+ (make-array (list nactvar nactvar) :initial-element .00001)
           (fuzz (correlation-matrix data-matrix)))
        w 
        :column-labels row-column-labels
        :row-labels row-column-labels)
    
       (display-string (format nil "~2%COVARIANCES (Numeric Variables)~%") w)
       (print-matrix-to-window 
        (fuzz (covariance-matrix data-matrix))
        w 
        :column-labels row-column-labels
        :row-labels row-column-labels)
       )
      (t
       (display-string (format nil "~2%Correlations and covariances cannot be computed.") w)
       (unless (> (length (first variables)) 2)
               (display-string 
                (format nil "~%There are not enough observations (3 minimum).") w))
       (unless (> nactvar 1) 
               (display-string (format nil "~%There is only 1 variable") w))
       ))))
      
(defmeth datasheet-proto :print-data-listing (dat-mat types col-labs row-labs w )
  (display-string (format nil   "~%Data Listing~2%") w)
  (send w :clear)
  (print-matrix-to-window  dat-mat w 
                           :variable-types types
                           :col-labels col-labs
                           :row-labels row-labs))

(defmeth mv-data-object-proto :add-crosstab-methods 
  (numvar-list numvar-types-list stats-list sp)
    
  (setf dob self)
  (defmeth numvar-list :plot-help ()
      (plot-help-window (strcat "Help for Numeric Variables"))
      (paste-plot-help (format nil "This window lists the numeric variables and lets you select subsets of these variables. You can select any number of variables. Only the selected variables are used to form the various statistical reports (and, in the future, graphics) shown in this spreadplot. ~2%")) 
      (paste-plot-help (format nil "You select a variable by clicking on its name. You can select several variables by dragging your mouse across them while holding the button down, or by control-clicking each variable."))
      (show-plot-help))
  (defmeth numvar-list :do-select-click (x y m1 m2)
    (when (not (send self :has-slot 'old-var-list))
          (send self :add-slot 'old-var-list)
          (defmeth self :old-var-list (&optional (avar-list nil set))
            (if set (setf (slot-value 'old-var-list) avar-list))
            (slot-value 'old-var-list)))
    (call-next-method x y m1 m2)
    
    (let* ((cur-var  (send self :selection))
           (old-var (send self :old-var-list))
           (nvar nil) (variable-labels nil)
           (var-labs nil) (cur-data nil) )
      (when cur-var
            (when (and m1 (send self :old-var-list))
                  (mapcar 
                   #'(lambda (i) 
                       (setf cur-var 
                             (remove (select old-var i) cur-var)))
                   (iseq (length old-var)))
                  (setf cur-var (combine old-var cur-var )) 
                  )
            (send self :old-var-list cur-var)
          ;  (setf nvar (send self :num-points))
          ;  (setf variable-labels 
          ;        (send self :point-label (iseq nvar)))
          ;  (setf var-labs (select variable-labels cur-var))
            (send sp :update-spreadplot 9 0  (send self :point-label cur-var) 
                  (select numvar-types-list cur-var) cur-var)
           ; (send self :show-window)
            )))

  (defmeth stats-list :plot-help ()
      (plot-help-window (strcat "Help for Stats/Graphics options"))
      (paste-plot-help (format nil "This window lists and lets you select the various statistical summaries and graphics that are shown by this spreadplot. You can select any combination of summaries and graphics. Only the selected summaries and graphics are shown in this spreadplot. ~2%")) 
      (paste-plot-help (format nil "You select a summary or graphic by clicking on its name. You can select several summaries or graphics by dragging your mouse across them while holding the button down, or by control-clicking each variable."))
      (show-plot-help))

  (defmeth stats-list :do-select-click (x y m1 m2)
    (when (not (send self :has-slot 'old-var-list))
          (send self :add-slot 'old-var-list)
          (defmeth self :old-var-list (&optional (avar-list nil set))
            (if set (setf (slot-value 'old-var-list) avar-list))
            (slot-value 'old-var-list)))
    (call-next-method x y m1 m2)
    
    (let* ((cur-var  (send self :selection))
           (old-var (send self :old-var-list))
           (nvar nil) (variable-labels nil)
           (var-labs nil) (cur-data nil) )
      (when cur-var
            (when (and m1 (send self :old-var-list))
                  (mapcar 
                   #'(lambda (i) 
                       (setf cur-var 
                             (remove (select old-var i) cur-var)))
                   (iseq (length old-var)))
                  (setf cur-var (combine old-var cur-var )) 
                  )
            (send self :old-var-list cur-var)
         ;   (setf nvar (send self :num-points))
         ;   (setf variable-labels 
         ;         (send self :point-label (iseq nvar)))
         ;   (setf var-labs (select variable-labels cur-var))
         ;   (setf cur-data 
         ;         (map-elements #'send dob
         ;                       :variable var-labs))
            (send sp :update-spreadplot 9 1 cur-var)
         ;   (send self :show-window)
            )))



  )


(defmeth mv-data-object-proto :add-crosstab-slots (sp)
    (send sp :add-slot 'active-numord-vars)
    (send sp :add-slot 'active-numord-vars-indices)
    (send sp :add-slot 'active-numord-types)
    (send sp :add-slot 'active-stats)
  (send sp :add-slot 'n-numordvar)
  (defmeth sp :n-numordvar (&optional (list nil set))
    (if set (setf (slot-value 'n-numordvar) list))
    (slot-value 'n-numordvar))
    (defmeth sp :active-stats (&optional (list nil set))
      (if set (setf (slot-value 'active-stats) list))
      (slot-value 'active-stats))
    (defmeth sp :active-numord-vars (&optional (list nil set))
      (if set (setf (slot-value 'active-numord-vars) list))
      (slot-value 'active-numord-vars))
    (defmeth sp :active-numord-vars-indices (&optional (list nil set))
      (if set (setf (slot-value 'active-numord-vars-indices) list))
      (slot-value 'active-numord-vars-indices))
    (defmeth sp :active-numord-types (&optional (list nil set))
      (if set (setf (slot-value 'active-numord-types) list))
      (slot-value 'active-numord-types))
    )

